#!/usr/bin/perl -wT
# $Id: hashcash.pl 100 2006-10-12 17:21:41Z cmauch $
# This is unsupported software -- use at your own risk!

use strict;
use Mail::Message;
use IPC::Open3;

# How many hashcash bits do I want to use
my $bits = 20;

# For safety we're running in Taint mode, which demands a safe $ENV{PATH}
$ENV{ 'PATH' } = '';

# hardcoded paths to our binaries
my $HASHCASH = '/usr/bin/hashcash';
my $MTA      = '/usr/sbin/sendmail';

# ----------------------------------------------------------------------
# SUBROUTINES

# Subroutine to do a tiny bit of sanity checking on arguments and untaint
# them.  Basically watches out for shell metachars and whitespace.
sub check {
    for my $a ( @_ ) { $a = $1 if $a =~ m#^([^\s;&`'\\]+)$#; }
  return wantarray ? @_ : $_[0];
}

# Subroutine to mint a hashcash token given a resource name (e-mail address)
sub hashcash_mint {
    my $res = shift;
  return undef unless $res =~ m#^([^\s;&`'\\]+)$#;
    my $addr     = $1;                               # now untainted
    my $hashcash = `$HASHCASH -mqXb$bits '$addr'`;
  return $hashcash;
}

# Subroutine to deliver a message to the MTA (e.g. sendmail)
sub deliver {
    my ( $head, $body, $mt_args, $rcpt ) = @_;
    my $wr;
    my $pid = open3( $wr, '>&STDOUT', '>&STDERR', $MTA, @$mt_args, '--', @$rcpt );
    $head->print( $wr );
    $body->print( $wr );
    $wr->close;
    waitpid $pid, 0;
    if ( $? ) {
        printf STDERR "errors in deliver (%#x)\n", $?;
        exit( $? >> 8 );
    }
} ## end sub deliver

# ----------------------------------------------------------------------
# BODY OF SCRIPT

# Split the MTA args from the list of recipients
my ( @mt_args, %rcpt );
while ( $_ = shift @ARGV ) { last if $_ eq '--'; push @mt_args, check( $_ ) }
for ( @ARGV ) { ++$rcpt{ check( $_ ) } }

# Read the message from the MUA on stdin
my $msg = Mail::Message->read( \*STDIN );

# Figure out who the message is being sent to.  Assemble the list of visible
# (To and Cc) recipients into the %vis hash, and the list of blind-copy
# (Bcc) recipients into the %bcc hash.  For obvious reasons, an MUA doesn't
# include the Bcc recipients in the message header, so we have to figure it
# out by subtracting the %vis list from the %rcpt list (from above).
my $head = $msg->head;
my ( %vis, %bcc );
for ( map { $_->address } $msg->to, $msg->cc ) {
    ++$vis{ $_ } unless m/^undisclosed.recipients.*/i;
}
for ( keys %rcpt ) { ++$bcc{ $_ } unless $vis{ $_ } }

# Build one message for the visible recipients
if ( scalar keys %vis ) {
    my $vhead = $head->clone;
    for my $addr ( sort keys %vis ) {
        my $token = hashcash_mint( $addr );
        $vhead->add( $token ) if $token;
    }
    deliver( $vhead, $msg->body, \@mt_args, [ keys %vis ] );
} ## end if ( scalar keys %vis )

# And a separate message for each of the blind-copy recipients
for my $addr ( keys %bcc ) {
    my $bhead = $head->clone;
    my $token = hashcash_mint( $addr );
    $bhead->add( $token ) if $token;
    deliver( $bhead, $msg->body, \@mt_args, [$addr] );
}
